Celestin Apprentice 4/Apprentice-Release4.iso/Languages/MPW Oberon 2.1168/OExamples/DAMemory.mod

Text File | 1995-07-03 | 4.5 KB | 160 lines | [TEXT/MPS ]

(*
 File DAMemory.p

 Copyright Apple Computer, Inc. 1985-1988
 All rights reserved.
*)

(*$R-*) (* No range checking  *)

MODULE DAMemory;

IMPORT SYSTEM, Types, Memory, QuickdrawText, Quickdraw, Events, Windows,
       Devices, TextUtils, Files, Desk, OSUtils, Fonts;

TYPE
    EventPtr = POINTER TO Events.EventRecord;
    CtlBlkPtr = POINTER TO OSUtils.CntrlParamBlockRec;

(*$S Main*) (* put routines in segment "Main" *)

PROCEDURE RsrcID(dCtl: Devices.DCtlPtr): INTEGER;
BEGIN
    RETURN BOR($C000, ASH(BNOT(dCtl.dCtlRefNum), 5))
END RsrcID;

(*$Calling Pascal*)
PROCEDURE DRVROpen*(ctlPB: OSUtils.ParmBlkPtr; dCtl: Devices.DCtlPtr): Types.OSErr;
VAR
    savePort:    Quickdraw.GrafPtr;
    heapGrow:    LONGINT;
    myWindow:    Windows.WindowPtr;
BEGIN
    IF dCtl.dCtlWindow = NIL THEN
        Quickdraw.GetPort (savePort);
            myWindow := Windows.GetNewWindow(RsrcID(dCtl), NIL, Windows.WindowPtr(-1));
            myWindow.windowKind := dCtl.dCtlRefNum;  (* show a DA owns this window *)
        dCtl.dCtlWindow := myWindow;    (* let the desk manager know too *)
        heapGrow := Memory.MaxMem (heapGrow);
        Quickdraw.SetPort (savePort)
    END;
    RETURN Types.noErr
END DRVROpen;


PROCEDURE DRVRClose*(ctlPB: OSUtils.ParmBlkPtr; dCtl: Devices.DCtlPtr): Types.OSErr;
BEGIN
    IF dCtl.dCtlWindow # NIL THEN
        Windows.DisposeWindow (dCtl.dCtlWindow);
        dCtl.dCtlWindow := NIL
    END;
    RETURN Types.noErr
END DRVRClose;


PROCEDURE DRVRControl*(ctlPB: CtlBlkPtr; dCtl: Devices.DCtlPtr): Types.OSErr;
(*$Calling Oberon*)

    PROCEDURE DrawWindow;
    VAR
        saveZone:            Memory.THz;
        tempStr,VolName:    Types.Str255;
        freeBytes:            LONGINT;
        ourID:                INTEGER;

        PROCEDURE PrintNum (num:LONGINT);    (*outputs the number in plain text*)
        VAR
            outStr: Types.Str255;
        BEGIN
            TextUtils.NumToString (num,outStr);
            QuickdrawText.TextFace (0);                    (* the empty set* = Plain *)
            QuickdrawText.DrawString (outStr);
            QuickdrawText.TextFace (Types.bold)
        END PrintNum;

        PROCEDURE GetVolStuff;
        VAR
            error:    Types.OSErr;
            myParamBlk: Files.HVolumeParamBlockRec;
        BEGIN
            myParamBlk.ioNamePtr := SYSTEM.ADR(VolName);
            myParamBlk.ioVRefNum := 0;         (* if ioVRefNum and ioVolIndex are zero, *)
            myParamBlk.ioVolIndex := 0;        (* go for the default volume. *)
            error := Files.PBHGetVInfo (SYSTEM.ADR(myParamBlk), FALSE);

            (* ioVFrBlk is an unsigned integer.  If > 32767 and assigned
              to freeBytes (a LongInt), Oberon will think it is negative
              and sign extend it.  The expression below masks off this
              high word so that freeBytes is correctly signed.  See
              tech note #157 more a more in-depth explanation. *)
            freeBytes := BAND(myParamBlk.ioVFrBlk, $0000FFFF) * myParamBlk.ioVAlBlkSiz;
        END GetVolStuff;

        PROCEDURE PrtRsrcStr(index: INTEGER);
        BEGIN
            TextUtils.GetIndString(tempStr, ourID, index);
            QuickdrawText.DrawString(tempStr);
        END PrtRsrcStr;

    BEGIN    (* DrawWindow *)
        ourID := RsrcID(dCtl);

        QuickdrawText.TextMode (Quickdraw.srcCopy);
        QuickdrawText.TextFont (Fonts.monaco);
        QuickdrawText.TextSize (9);
        QuickdrawText.TextFace (Types.bold);

        Quickdraw.MoveTo (6,10); PrtRsrcStr(1);    (* "AppHeap: " *)
        saveZone := Memory.GetZone();
        Memory.SetZone (Memory.ApplicZone());
        PrintNum (Memory.FreeMem());

        PrtRsrcStr(2);    (* " SysHeap: " *)
        Memory.SetZone (Memory.SystemZone());
        PrintNum (Memory.FreeMem());
        Memory.SetZone (saveZone);         (* always put things back the way you found them *)

        PrtRsrcStr(3);        (* " Disk: " *)
        GetVolStuff;
        PrintNum (freeBytes);

        PrtRsrcStr(4);        (* " free on " *)
        QuickdrawText.TextFace (Types.underline);
        QuickdrawText.DrawString (VolName);
    END DrawWindow;

VAR
    eventAt:    EventPtr;    (* Pointer to our event *)

BEGIN
    Quickdraw.SetPort(dCtl.dCtlWindow); (* the desk manager restores thePort*)
    CASE ctlPB.csCode OF
        Desk.accEvent:
            SYSTEM.GET(SYSTEM.ADR(ctlPB.csParam), eventAt);    (* get the event pointer *)
            IF eventAt.what = Events.updateEvt THEN (* we only handle one event *)
                Windows.BeginUpdate (Windows.WindowPtr(eventAt.message));
                    DrawWindow;
                Windows.EndUpdate (Windows.WindowPtr(eventAt.message));
            END| (* of accEvent Case *)

        Desk.accRun:         (* our periodic call *)
            DrawWindow|
        ELSE (* igore other events *)
    END; (* of CASE *)
    RETURN Types.noErr
END DRVRControl;

(*$Calling Pascal*)
PROCEDURE DRVRPrime* (ctlPB: OSUtils.ParmBlkPtr; dCtl: Devices.DCtlPtr): Types.OSErr;
BEGIN
    RETURN Types.noErr;
END DRVRPrime;

PROCEDURE DRVRStatus* (ctlPB: OSUtils.ParmBlkPtr; dCtl: Devices.DCtlPtr): Types.OSErr;
BEGIN
    RETURN Types.noErr;
END DRVRStatus;
(*$Calling Oberon*)

END DAMemory.